BOI '96, Nicosia, oct. 1996
Problema 2 (Sateliti)

Se preconizeaza lansarea pe orbita a unui grup de sateliti. Doi
sateliti pot transmite date de la unul la altul fie in mod direct, fie
indirect (adica prin intermediul altor sateliti intermediari); de asemenea 
este posibil sa nu aiba nici o legatura. Spunem ca doi sateliti sunt vecini 
numai daca ei pot transmite unul altuia date in mod direct.
	Fiind date un numar n si un set de n numere intregi, se cere:
a) Sa se stabileasca daca exista o configuratie de n sateliti astfel 
incat setul de n numere citite la intrare sa corespunda vecinilor satelitilor;
b) Daca raspunsul la punctul (a) este YES, atunci descrieti o astfel de
configuratie;
c) Fiind data configuratia din (b), decideti daca se pot trimite date
de la oricare satelit la oricare altul.
 
Intrare (fisier INPUT.TXT):
Fisierul de intrare contine o singura linie pe care se afla o secventa
de numere intregi separate prin cate un spatiu. Primul numar, n<=20 da
numarul de sateliti de pe orbita. Urmatoarele n numere intregi 
reprezinta numarul de vecini ai fiecarui satelit. Atentie! Ordinea 
in care sunt date numerele vecinilor directi nu are nici o importanta.

Iesire (fisier OUTPUT.TXT):
Prima linie a fisierului de iesire contine raspunsul la punctul (a):
YES sau NO.
Daca raspunsul este NO, nu se mai cere altceva la iesire;
Daca raspunsul este YES, atunci urmeaza n linii, fiecare cu cate n
numere 0/1, separate prin cate un spatiu, formand o matrice nxn.
Satelitii i si j sunt vecini daca si numai daca al (i,j)-lea element 
al matricii este 1.
A (n+2)-a linie a fisierului de iesire corespunde punctului (c) si este
un YES sau NO.

Exemplul 1:
Intrare:			Iesire:
6 4 3 1 4 2 0			NO

Exemplul 2:
Intrare:			Iesire:
7 4 3 1 5 4 2 1			YES
				0 1 1 1 1 1 0
				1 0 1 0 0 0 0
				1 1 0 1 0 1 0
				1 0 1 0 0 1 0
				1 0 0 0 0 0 0
				1 0 1 1 0 0 1
				0 0 0 0 0 1 0
				YES

Exemplul 3:
Intrare:			Iesire:
6 2 3 1 1 2 1			YES
				0 1 0 1 0 0
				1 0 1 1 0 0
				0 1 0 0 0 0
				1 1 0 0 0 0
				0 0 0 0 0 1
				0 0 0 0 1 0
				NO

Limita de timp per test: 20 secunde;
Punctaj maxim: 35 puncte
=============================
test 1 (2 p)
Intrare:
6 4 3 1 4 2 0
Iesire:
NO
------------
test 2 (3 p)
Intrare:
7 4 3 1 5 4 2 1
Iesire:
YES
0 1 1 1 1 1 0
1 0 1 0 0 0 0
1 1 0 1 0 1 0
1 0 1 0 0 1 0
1 0 0 0 0 0 0
1 0 1 1 0 0 1
0 0 0 0 0 1 0
YES
-------------
test 3 (5p)
Intrare:
6 2 3 1 1 2 1
Iesire:
YES
0 1 0 1 0 0
1 0 1 1 0 0
0 1 0 0 0 0
1 1 0 0 0 0
0 0 0 0 0 1
0 0 0 0 1 0
NO
----------
Test 4 (10 p)
Intrare:
10 9 9 9 9 9 9 9 9 9 9
Iesire:
0 1 1 1 1 1 1 1 1 1
1 0 1 1 1 1 1 1 1 1
1 1 0 1 1 1 1 1 1 1
1 1 1 0 1 1 1 1 1 1
1 1 1 1 0 1 1 1 1 1
1 1 1 1 1 0 1 1 1 1
1 1 1 1 1 1 0 1 1 1
1 1 1 1 1 1 1 0 1 1
1 1 1 1 1 1 1 1 0 1
1 1 1 1 1 1 1 1 1 0
YES
----------------
test 5 (15 p)
Intrare:
20 19 19 19 19 19 19 19 19 19 19 19 19 19 19 19 19 19 19 19 1
Iesire:
NO
===================================
Solutia 1 (Mihai badoiu)
{$A+,B-,D-,E-,F-,G+,I-,L-,N+,O-,P-,Q-,R-,S-,T-,V+,X+,Y-}
{$M 65520,0,655360}
var
	n:integer;
	sat:array[1..32] of integer;
	v,g: array[1..32,1..32] of byte;

procedure load;
var
	f:text;
	i:integer;
begin
	assign(f,'input.txt');
	reset(f);
	read(f,n);
	for i:=1 to n do
		read(f,sat[i]);
	close(f);
end;

function alege_max:integer;
var
	i,j:integer;
begin
	j:=1;
	for i:=2 to n do
	if sat[i]>sat[j] then
		j:=i;
	alege_max:=j;
end;

function scoate(l:integer):boolean;
var
	i,j,k: integer;
begin
	for k:=20 downto 1 do
	begin
		for i:=1 to n do
		if (sat[i]=k) and (i<>l) and (v[i,l]=0) then
		begin
			dec(sat[i]);
			dec(sat[l]);
			v[i,l]:=1;
			v[l,i]:=1;
			if sat[l]=0 then
			begin
				scoate:=true;
				exit;
				end;
			end;
		end;
	scoate:=false;
end;

procedure scrie_no;
var
	f:text;
begin
	assign(f,'output.txt');
	rewrite(f);
	writeln(f,'NO');
	close(f);
	halt;
end;

procedure p_ab;
var
	i,j:integer;
begin
	for i:=1 to n do
	begin
		j:=alege_max;
		if sat[j]<>0 then
		begin
			if not scoate(j) then
			begin
				scrie_no;
				end;
			end;
		end;
end;

procedure p_c;
var
	i,j,k: integer;
begin
	g:=v;
	for i:=1 to n do
		g[i,i]:=1;
	for i:=1 to n do
		for j:=1 to n do
		if g[i,j]=1 then
		for k:=1 to n do
		if g[j,k]=1 then
			g[i,k]:=1;
end;

procedure calcul;
begin
	p_ab;
	p_c;
end;

procedure scrie;
var
	f: text;
	i, j: integer;
	b: boolean;
begin
	assign(f,'output.txt');
	rewrite(f);
	writeln(f,'YES');
	for i:=1 to n do
	begin
		write(f,v[i,1]);
		for j:=2 to n do
			write(f,' ',v[i,j]);
		writeln(f);
		end;
	b:=true;
	for i:=1 to n do
		for j:=1 to n do
		if g[i,j]=0 then
			b:=false;
	if b then
		writeln(f,'YES')
	else
		writeln(f,'NO');
	close(f);
end;

procedure sort;
var
	i,j,k: integer;
begin
	for i:=1 to n do
		for j:=i+1 to n do
		if sat[i]<sat[j] then
		begin
			k:=sat[i];
			sat[i]:=sat[j];
			sat[j]:=k;
			end;
end;

begin
	load;
	sort;
	calcul;
	scrie;
end.
-----------------------------
Solutia 2 (Valentin Gheorghita)
program satelite_configuration;
var a:array[1..20,1..20] of boolean;
    s:array[1..20] of integer;
    max,pz,k,n,i,j,tmp:integer;
    f:text;
    sel:array[1..20] of boolean;
    tst:boolean;
begin
 assign(f,'INPUT.TXT');
 reset(f);
 read(f,n);
 for i:=1 to n do read(f,s[i]);
 close(f);
 for i:=1 to n do
  for j:=1 to n do
   a[i,j]:=false;
 for i:=1 to n-1 do
  for j:=i+1 to n do
   if s[i]<s[j] then begin
                      tmp:=s[i];
                      s[i]:=s[j];
                      s[j]:=tmp;
                     end;
 for i:=1 to n do
  begin
   for j:=i+1 to n do sel[j]:=false;
   max:=1;
   while(s[i]>0) and (max>0) do
    begin
     max:=0;
     for j:=i+1 to n do
      if (s[j]>max) and not(sel[j]) then begin
                                          pz:=j;
                                          max:=s[j];
                                         end;
     if max>0 then begin
                    sel[pz]:=true;
                    s[pz]:=s[pz]-1;
                    s[i]:=s[i]-1;
                    a[i,pz]:=true;
                    a[pz,i]:=true;
                   end;
    end;
   if s[i]>0 then begin
                   assign(f,'OUTPUT.TXT');
                   rewrite(f);
                   writeln(f,'NO');
                   close(f);
                   halt;
                  end;
  end;
 assign(f,'OUTPUT.TXT');
 rewrite(f);
 writeln(f,'YES');
 for i:=1 to n do
  begin
   for j:=1 to n do
    if a[i,j] then write(f,'1 ')
              else write(f,'0 ');
   writeln(f);
  end;
 repeat
  tst:=true;
  for k:=1 to n do
   for i:=1 to n-1 do
    for j:=i+1 to n do
     if a[i,k] and a[k,j] and not(a[i,j]) then begin
                                                a[i,j]:=true;
                                                a[j,i]:=true;
                                                tst:=false;
                                               end;
 until tst;
 tmp:=0;
 for i:=1 to n do
  for j:=1 to n do
   if a[i,j] then tmp:=tmp+1;
 if tmp=n*(n-1) then writeln(f,'YES')
                else writeln(f,'NO');
 close(f);
end.
--------------------------
Solutia 3 (Angel Proorocu)
program LansareDeSateleti;
   uses Crt;
   var cerut,compl:array[1..20]of integer;
       n,j,i:integer;
       a:array[1..20,1..20]of byte;
       f:text;
       sw:boolean;

procedure ReadData;
   var i,j:integer;
       sw:boolean;
   begin
     clrscr;
     assign(f,'input.txt');
     reset(f);
     read(f,n);
     for i:=1 to n do read(f,cerut[i]);
     close(f);
     for i:=1 to n do
      begin
       for j:=1 to n do a[i,j]:=0;
       compl[i]:=0;
      end;
     sw:=true;
     while sw do
      begin
       sw:=false;
       for i:=1 to n-1 do if cerut[i]<cerut[i+1] then
        begin
          j:=cerut[i];
          cerut[i]:=cerut[i+1];
          cerut[i+1]:=j;
          sw:=true;
        end;
      end;
   end;

function ConfiguratieValida:boolean;
   var i,j,k,l:integer;
   begin
      ConfiguratieValida:=true;

      for i:=1 to n do
       begin
        if cerut[i]>compl[i] then
          begin
            k:=cerut[i]-compl[i];
            l:=0;
            if i=n then
             begin
              ConfiguratieValida:=false;
              exit;
             end;
            for j:=i+1 to n do if cerut[j]>compl[j] then
             if l<k then
               begin
                inc(l);
                inc(compl[j]);
                inc(compl[i]);
                a[i,j]:=1;
                a[j,i]:=1;
               end;
            if l<k then
              begin
                ConfiguratieValida:=false;
                exit;
              end;
          end;
       end;
   end;

function Conex:boolean;
   var i,j:integer;
       sw:boolean;
   begin
     conex:=true;
     for i:=1 to n do compl[i]:=0;
     compl[1]:=1;

     sw:=true;
     while sw do
      begin
        sw:=false;
        for i:=1 to n do if compl[i]=1 then
          for j:=1 to n do if compl[j]=0 then
           if a[i,j]=1 then
            begin
             compl[j]:=1;
             sw:=true;
            end;
     end;
    for i:=1 to n do if compl[i]=0 then conex:=false;
   end;

begin
   ReadData;
   assign(f,'output.txt');
   rewrite(f);
   sw:=ConfiguratieValida;
   if sw then writeln(f,'YES')
         else writeln(f,'NO');
    if sw then
      begin
        for i:=1 to n do
         begin
          for j:=1 to n do write(f,a[i,j],' ');
          writeln(f);
         end;
        sw:=conex;
        if sw then writeln(f,'YES')
              else writeln(f,'NO');
     end;
  close(f);
  writeln('Rezultatul se afla in OUTPUT.TXT..');
  readkey;
end.
------------------------------
Solutia 4 (Alin Simpalean)
program p5_Sateliti;
  var n:byte;
      sat,os:packed array[1..100] of byte;
      mad:packed array[1..100,1..100] of byte;
  procedure Citire;
    var f:text;
        i:byte;
    begin
      assign(f,'p5.in');
      reset(f);
      read(f,n);
      for i:=1 to n do
        read(f,sat[i]);
      close(f)
    end;
  procedure Rezolvare;
    var i,j,k,m,c,p,ns,ons:byte;
        f:text;
        sel:packed array[1..100] of boolean;
    begin
      for i:=1 to n do
        os[i]:=i;
      for i:=1 to n-1 do
        begin
          m:=i;
          for j:=i+1 to n do
            if sat[j]>sat[m] then m:=j;
          c:=sat[i]; sat[i]:=sat[m]; sat[m]:=c;
          c:=os[i]; os[i]:=os[m]; os[m]:=c
        end;
      fillchar(mad,sizeof(mad),0);
      assign(f,'p5.out');
      rewrite(f);
      for i:=1 to n-1 do
        begin
          if sat[i]>n-i then
                begin
                  writeln(f,'NO');
                  close(f);
                  halt(0)
                end;
          for j:=i+1 to i+sat[i] do
            begin
              dec(sat[j]);
              mad[os[i],os[j]]:=1;
              mad[os[j],os[i]]:=1;
              if sat[j]<0 then
                begin
                  writeln(f,'NO');
                  close(f);
                  halt(0)
                end
            end;
          p:=0;
          for j:=i+1 to n-1 do
            begin
              m:=j;
              for k:=j+1 to n do
                if sat[m]<sat[k] then m:=k;
                c:=sat[j]; sat[j]:=sat[m]; sat[m]:=c;
                c:=os[j]; os[j]:=os[m]; os[m]:=c
            end
        end;
      writeln(f,'YES');
      for i:=1 to n do
        begin
          for j:=1 to n do
            write(f,mad[i,j],' ');
          writeln(f)
        end;
      fillchar(sel,n,false);
      sel[1]:=true;
      ns:=1;
      repeat
        ons:=ns;
        for i:=1 to n do
          if sel[i] then
            for j:=1 to n do
              if (mad[os[i],os[j]]=1) and not sel[j] then
                begin
                  inc(ns);
                  sel[j]:=true
                end;
      until ns=ons;
      if ns=n then writeln(f,'YES')
              else writeln(f,'NO');
      close(f)
    end;
  begin
    Citire;
    Rezolvare
  end.
---------------------------------
Solutia 5 (Mihai Stroe)
var i,j,k,l,max,mp,m,n:longint;
    a:array[1..20,1..20]of byte;
    fi,fo:text;
    d,nr:array[1..20]of longint;
    luate:set of byte;

procedure readdata;
begin
  assign(fi,'input.txt');
  assign(fo,'output.txt');
  reset(fi);
  rewrite(fo);
  read(fi,n);
  for i:=1 to n do
      read(fi,d[i]);
  close(fi);
end;

procedure sort;
begin
  for i:=1 to n do
      begin
        max:=d[i];
        mp:=i;
        for j:=i+1 to n do
            if d[j]>max then
               begin
                 max:=d[j];
                 mp:=j;
               end;
        k:=nr[i];
        nr[i]:=nr[mp];
        nr[mp]:=k;
        d[mp]:=d[i];
        d[i]:=max;
      end;
end;

procedure solve;
begin
  for i:=1 to n do
      nr[i]:=i;
  sort;
  while d[1]>0 do
    begin
      for i:=2 to d[1]+1 do
          if d[i]>0 then
             begin
               dec(d[i]);
               dec(d[1]);
               a[nr[i],nr[1]]:=1;
               a[nr[1],nr[i]]:=1;
             end
             else
             begin
               writeln(fo,'NO');
               close(fo);
               halt;
             end;
      sort;
    end;
  writeln(fo,'YES');
  for i:=1 to n do
      begin
        for j:=1 to n do
            write(fo,a[i,j],' ');
        writeln(fo);
      end;
  luate:=[1];
  for k:=1 to n do
      for i:=1 to n do
          for j:=1 to n do
              if (a[i,j]in luate)and(i in luate)then
                 luate:=luate+[j];
  if luate=[1..n] then writeln(fo,'YES') else writeln(fo,'NO');
  close(fo);
end;

begin
  readdata;
  solve;
end.
--------------------------
Solutia 6 (Valentin Gheorghita)
program satelite_configuration;
var a:array[1..20,1..20] of boolean;
    s:array[1..20] of integer;
    max,pz,k,n,i,j,tmp:integer;
    f:text;
    sel:array[1..20] of boolean;
    tst:boolean;
begin
 assign(f,'INPUT.TXT');
 reset(f);
 read(f,n);
 for i:=1 to n do read(f,s[i]);
 close(f);
 for i:=1 to n do
  for j:=1 to n do
   a[i,j]:=false;
 for i:=1 to n-1 do
  for j:=i+1 to n do
   if s[i]<s[j] then begin
                      tmp:=s[i];
                      s[i]:=s[j];
                      s[j]:=tmp;
                     end;
 for i:=1 to n do
  begin
   for j:=i+1 to n do sel[j]:=false;
   max:=1;
   while(s[i]>0) and (max>0) do
    begin
     max:=0;
     for j:=i+1 to n do
      if (s[j]>max) and not(sel[j]) then begin
                                          pz:=j;
                                          max:=s[j];
                                         end;
     if max>0 then begin
                    sel[pz]:=true;
                    s[pz]:=s[pz]-1;
                    s[i]:=s[i]-1;
                    a[i,pz]:=true;
                    a[pz,i]:=true;
                   end;
    end;
   if s[i]>0 then begin
                   assign(f,'OUTPUT.TXT');
                   rewrite(f);
                   writeln(f,'NO');
                   close(f);
                   halt;
                  end;
  end;
 assign(f,'OUTPUT.TXT');
 rewrite(f);
 writeln(f,'YES');
 for i:=1 to n do
  begin
   for j:=1 to n do
    if a[i,j] then write(f,'1 ')
              else write(f,'0 ');
   writeln(f);
  end;
 repeat
  tst:=true;
  for k:=1 to n do
   for i:=1 to n-1 do
    for j:=i+1 to n do
     if a[i,k] and a[k,j] and not(a[i,j]) then begin
                                                a[i,j]:=true;
                                                a[j,i]:=true;
                                                tst:=false;
                                               end;
 until tst;
 tmp:=0;
 for i:=1 to n do
  for j:=1 to n do
   if a[i,j] then tmp:=tmp+1;
 if tmp=n*(n-1) then writeln(f,'YES')
                else writeln(f,'NO');
 close(f);
end.
---------------------------
